00100	BEGIN "PIX"
00200	
00300	REQUIRE "HELIB[1,3]" LIBRARY;
00400	REQUIRE "DPYSUB.HDR[1,PDQ]" SOURCE_FILE;
00500	REQUIRE "SOBMAT[SYS,HE]" LOAD_MODULE;
00600	REQUIRE 2000 STRING_SPACE;
00700	REQUIRE "⊂⊃||" DELIMITERS;
00800	
00900	DEFINE α=⊂COMMENT⊃, EXT=⊂EXTERNAL⊃, INT=⊂INTEGER⊃, PRO=⊂PROCEDURE⊃,
01000		CRLF=⊂'15&'12⊃, BHEAD(BUF)=⊂(BUF+1) LAND '777777⊃, REF=⊂REFERENCE⊃,
01100		RED=⊂0⊃, BLUE=⊂1⊃, GREEN=⊂2⊃, CLEAR=⊂3⊃;
01200	EXT PRO PICINI(INT CHAN, FILE, EXTEN, PPN;REF BOOLEAN FAIL;INT ARRAY STOR);
01300	EXT PRO PICRD(REF BOOLEAN FAIL; INT ARRAY STOR);
01400	EXT PRO PICWR(INT CHAN, FILE, EXTEN, PPN; REF BOOLEAN FAIL; INT ARRAY STOR);
01500	EXT PRO RELCOR(INT IOWD);
01600	EXT INT PRO GETCOR(INT SIZE);
01700	EXT PRO INP;
01800	EXT INT PRO GIOWD(INT ARRAY BUF);
01900	EXT PRO EYECAL(INT SIZE, FRAM, FLAG; INT ARRAY BUF);
02000	EXT PRO CWHEEL(INT CODE);
02100	EXT PRO TVIN;
02200	EXT PRO PRDUMP;
02300	EXT PRO PORTR;
02400	EXTERNAL PROCEDURE SPWON(INTEGER TIC;REFERENCE INTEGER ADDR);
02500	EXTERNAL PROCEDURE CALLEN;
02600	EXTERNAL PROCEDURE SPWOFF;
02700	EXT INT TVWORD, FLINE, LLINE, RSIDE, LSIDE, TCLIP, BCLIP, PRTBUF,
02800		L1, L2, L3, P1,P2,P3,STATUS,TSERVO,LENS,TVCAM;
02900	
03000	SAFE INT ARRAY PNTRS[1:25];
03100	SAFE REAL ARRAY CAMERA_MODEL[1:10,1:3],PPOT0,PPOTD,TPOT0,TPOTD,FPOT0,FPOTD,
03200		MART,SWING,FOC,FOCLEN0,FOCLENG[1:4],DP,P0[1:4,1:3],PP[1:4,1:2];
03300	INT N, LIN, I, II, III, ANS, TVLENG;
03400	REAL PANPOT, FOCPOT, TILPOT;
03500	LABEL RUSE, LOOP;
03600	STRING STR, INS;
03650	PRELOAD_WITH "R","B","G"; STRING ARRAY CFIRST[1:3];
03700	SAFE INTEGER ARRAY PICALLOC[1:3];  α  allocation table for data blocks;
03800	α	first we initialize the world;
03900		QUICK_CODE '051000000000 '10,0; END;
04000		INS ← INCHWL;
04100		CLRBUF;
04200		OUTSTR(CRLF&"TYPE ALTMODE TO CHANGE CHANNEL"&CRLF&CRLF&
04210			"TYPE SPACE TO TAKE A PICTURE"&CRLF&CRLF&
04220			"FOR CHAN 51 (THE OLD HAND EYE CAMERA)"&CRLF&
04230			"YOU MAY ALSO TYPE"&CRLF&
04240			"  C - TO TAKE A COLOR PICTURE (THREE FILES)"&CRLF&
04250			"  R - TO TAKE A PICTURE THROUGH THE RED FILTER"&CRLF&
04260			"  B - TO TAKE A BLUE PICTURE"&CRLF&
04270			"  G - TO TAKE A GREEN PICTURE"&CRLF);
04300		WHILE LENGTH(INS) ≥ 2 ∧ INS[1 TO 1] ≠ ";" DO INS ← INS[2 TO ∞];
04400		LIN ← IF INS[1 TO 1]=";" THEN CVO(INS[2 TO ∞]) ELSE '15;
04500	LOOP:	TVCAM ← IF (LIN LAND 7) = 1 THEN 1 ELSE
04600			IF (LIN LAND 7) = 2 THEN 2 ELSE 
04700			IF (LIN LAND 7) = 0 THEN 0 ELSE 3;
04800		START_CODE
04900			LABEL XX1,GOO;
05000			JRST GOO;
05100		XX1:	'401401000000 LIN;
05200		GOO:	MOVE 1,XX1;
05300			CALLI 1,'400070;
05400			SKIP	0;
05500		END;
05600		TCLIP ← 0;
05700		BCLIP ← 7;
05800		PICALLOC[1] ← PICALLOC[2] ← PICALLOC[3] ← PNTRS[1] ← 0;
05900		ARRBLT(PNTRS[2],PNTRS[1],24);
06000				FLINE←'13;
06100				LLINE←'373;
06200				RSIDE←'512;
06300				LSIDE←'13;
06400			TVLENG ← ((RSIDE-LSIDE)/9+1)*(LLINE-FLINE+1);
06500			PICALLOC[1] ← GETCOR(TVLENG);
06600			IF TVCAM = 1 THEN
06700			BEGIN
06800			PICALLOC[2]←GETCOR(TVLENG);
06900			PICALLOC[3]←GETCOR(TVLENG);
07000			END;
07100			OUTSTR("*");
07200				IF (I ← INCHRW) = '175 THEN
07300					BEGIN
07400					OUTSTR("CHANNEL=");
07500					LIN←CVO(INCHWL);
07600					GO TO RUSE;
07700					END;
07800			I ← IF I > '140 ∧ I < '173 THEN I - '40 ELSE I;
07900			II ←	IF I = '103 THEN RED ELSE
08000				IF I = '102 THEN BLUE ELSE
08100				IF I = '107 THEN GREEN ELSE
08200				IF I = '122 THEN RED ELSE CLEAR;
08300			III ←	IF I = '103 ∧ TVCAM = 1 THEN GREEN ELSE II;
08500			N ← 0;
08600			FOR I ← II STEP 1 UNTIL III DO
08700			BEGIN EXTERNAL INTEGER IND;
08800				IF TVCAM = 1 THEN
08900				BEGIN
09000					CWHEEL(6);
09100					IF IND ≠ I THEN
09200					BEGIN INTEGER M;
09300						CWHEEL(I);
09400						M ← 12000;
09500						WHILE M ← M - 1 DO;
09600					END;
09700				END;
09800				TVWORD ← PICALLOC[N ← N + 1];
09900				TVIN;
10000			END;
10100			BEGIN "DSKOUT"
10200			INTEGER FILE, PPN, EXTEN, FAIL;
10300			STRING FILOUT;
10400			LABEL LOOP3;
10500	LOOP3:		OUTSTR("FILE NAME=");
10600			STR ← INCHWL;
10700			IF LENGTH(STR)≠0 THEN
10800			FOR I ← 1 STEP 1 UNTIL III-II+1 DO
10900			BEGIN
11000			PNTRS[1]←PICALLOC[I];
11100			FILOUT←IF II=III THEN STR ELSE CFIRST[I]&STR;
11200			FILE←CVFIL(FILOUT,EXTEN,PPN);
11300			PICWR(1,FILE,EXTEN,PPN,FAIL,PNTRS);
11400			IF FAIL THEN BEGIN USERERR(0,0,"WRITING OF FILE "
11500				&FILOUT&" FAILED"); GO TO LOOP3;END;
11600			OUTSTR("FILE "&FILOUT&" WRITTEN OUT"&CRLF);
11700			END;
11800			END "DSKOUT";
11900	α	return for next picture;
12000	
12100	RUSE:	FOR I ← 1 STEP 1 UNTIL 3 DO
12200			BEGIN
12300			IF PICALLOC[I] THEN RELCOR(PICALLOC[I]);
12400			PICALLOC[I] ← PNTRS[I] ← 0;
12500			END;
12600			GO TO LOOP;
12700	END;